home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Visual Database / Visual BASIC 5.0 (Ent. Edition) / Vb5ent Extractor.EXE / VB / SAMPLES / ENTRPRIS / APE / AECLIENT / CLSDRTTL.CLS < prev    next >
Encoding:
Visual Basic class definition  |  1996-11-16  |  9.6 KB  |  223 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "clsDirectTestTool"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = False
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = False
  10. Option Explicit
  11. '-------------------------------------------------------------------------
  12. 'This class provides a RunTest method to be called to run a Direct
  13. 'Instanciation model test.
  14. '-------------------------------------------------------------------------
  15.  
  16. Public Sub RunTest()
  17.     '-------------------------------------------------------------------------
  18.     'Purpose:   Executes a loop for glNumberOfCalls each time calling
  19.     '           AEWorker.Worker.DoActivity.  This method actually runs
  20.     '           a test according to set properties
  21.     'Assumes:   All Client properties have been set.
  22.     'Effects:
  23.     '           Calls CompleteTest when finished calling Worker
  24.     '   [gbRunning]
  25.     '           Is true during procedure
  26.     '   [glFirstServiceTick]
  27.     '           becomes the tick count of when the test is started
  28.     '   [glLastCallbackTick]
  29.     '           becomes the tick count of when the last call is made
  30.     '   [glCallsMade]
  31.     '           is incremented every time the Worker is called
  32.     '-------------------------------------------------------------------------
  33.     
  34.     'Called by tmrStartTest so that the StartTest method can release
  35.     'the calling program.
  36.     
  37.     Const lMAX_COUNT = 2147483647
  38.     Dim s As String         'Error message
  39.     Dim lServiceID As Long  'Service Request ID
  40.     Dim lTicks As Long      'Tick Count
  41.     Dim lEndTick As Long    'DoEvents loop until this Tick Count
  42.     Dim lCallNumber As Long 'Number of calls to Worker
  43.     Dim lNumberOfCalls As Long      'Test duration in number of calls
  44.     Dim iDurationMode As Integer    'Test duration mode
  45.     Dim lDurationTicksEnd As Long   'Tick that test should end on
  46.     Dim bPostingServices As Boolean 'In main loop of procedure
  47.     Dim iRetry As Integer           'Number of call reties made by error handling resume
  48.     Dim vSendData As Variant        'Data to send with Service request
  49.     Dim bRandomSendData As Boolean  'If true vSendData needs generated before each new request
  50.     Dim sSendCommand As String      'Command string to be sent with Service Request
  51.     Dim bRandomCommand As Boolean   'If true sSendCommand needs generated before each new request
  52.     Dim lCallWait As Long           'Number of ticks to wait between calls
  53.     Dim bRandomWait As Boolean      'If true lCallWait needs generated before each new request
  54.     Dim bSendSomething As Boolean    'If true data needs passed with request
  55.     Dim bReceiveSomething As Boolean 'If true data is expected back from request
  56.     Dim oWorker As AEWorker.Worker  'Local reference to the Worker
  57.     Dim bLog As Boolean             'If true log records
  58.     Dim bShow As Boolean            'If true update display
  59.     
  60.     On Error GoTo RunTestError
  61.     'If there is reentry by a timer click exit sub
  62.     If gbRunning Then Exit Sub
  63.     gbRunning = True
  64.     
  65.     'Set the local variables to direct the testing
  66.     Set oWorker = New AEWorker.Worker
  67.     'Pass configuration settings to the Worker
  68.     With oWorker
  69.         .SetProperties gbLogWorker, gbEarlyBindServices, gbPersistentServices
  70.         If gbPreloadServices Then .LoadServiceObject gsServiceCommand
  71.     End With
  72.     
  73.     bRandomSendData = GetTestData(bSendSomething, bReceiveSomething, vSendData)
  74.     lCallWait = GetValueFromRange(gudtWaitPeriod, bRandomWait)
  75.     sSendCommand = GetServiceCommand(bRandomCommand)
  76.     bLog = gbLog
  77.     bShow = gbShow
  78.     
  79.     s = LoadResString(giTEST_STARTED)
  80.     If bLog Then AddLogRecord 0, s, GetTickCount(), False
  81.     DisplayStatus s
  82.     glFirstServiceTick = GetTickCount()
  83.     
  84.     'Test duration variables
  85.     iDurationMode = giTestDurationMode
  86.     If iDurationMode = giTEST_DURATION_CALLS Then
  87.         lNumberOfCalls = glNumberOfCalls
  88.     ElseIf iDurationMode = giTEST_DURATION_TICKS Then
  89.         lDurationTicksEnd = glFirstServiceTick + glTestDurationInTicks
  90.     End If
  91.     
  92.     bPostingServices = True
  93. KeepPostingServices:
  94.     Do While Not gbStopping
  95.         'Check if new data needs generated because of randomization
  96.         If bRandomSendData Then bRandomSendData = GetTestData(bSendSomething, bReceiveSomething, vSendData)
  97.         If bRandomWait Then lCallWait = GetValueFromRange(gudtWaitPeriod, bRandomWait)
  98.         If bRandomCommand Then sSendCommand = GetServiceCommand(bRandomCommand)
  99.         
  100.         'Increment number of calls made
  101.         lCallNumber = glCallsMade + 1
  102.         'Post the service to a worker
  103.         'Post a synchronous service
  104.         iRetry = 0
  105.         If bSendSomething Then
  106.             oWorker.DoService lServiceID, sSendCommand, vSendData
  107.         Else
  108.             oWorker.DoService lServiceID, sSendCommand
  109.         End If
  110.         'Display CallsMade
  111.         If bShow Then
  112.             With frmClient
  113.                 .lblCallsMade = lCallNumber
  114.                 .lblCallsReturned = lCallNumber
  115.                 .lblCallsMade.Refresh
  116.                 .lblCallsReturned.Refresh
  117.             End With
  118.         End If
  119.         'If gbStopping Then Exit Do
  120.         'Go into an idle loop util the next call.
  121.         If lCallWait > 0 Then
  122.             lEndTick = GetTickCount + lCallWait
  123.             Do While GetTickCount() < lEndTick And Not gbStopping
  124.                 DoEvents
  125.             Loop
  126.         End If
  127.         glCallsMade = lCallNumber
  128.         
  129.         'See if it is time to stop the test
  130.         If iDurationMode = giTEST_DURATION_CALLS Then
  131.             If lCallNumber >= lNumberOfCalls Then Exit Do
  132.         ElseIf iDurationMode = giTEST_DURATION_TICKS Then
  133.             If GetTickCount >= lDurationTicksEnd Then Exit Do
  134.         End If
  135.     Loop
  136. StopTestNow:
  137.     bPostingServices = False
  138.     glLastCallbackTick = GetTickCount()
  139.     gbRunning = False
  140.     Set oWorker = Nothing
  141.     If gbStopping Then
  142.         'Someone hit the stop button on the Explorer.
  143.         gStopTest
  144.         Exit Sub
  145.     End If
  146.     If bLog Then AddLogRecord 0, LoadResString(giSERVICES_POSTED), GetTickCount(), False
  147.     CompleteTest
  148.     Exit Sub
  149. RunTestError:
  150.     Select Case Err.Number
  151.         Case RPC_E_CALL_REJECTED
  152.             'Collision error, the OLE server is busy
  153.             Dim il As Integer
  154.             Dim ir As Integer
  155.             'First check if stopping test
  156.             If gbStopping Then GoTo StopTestNow
  157.             If bLog Then AddLogRecord 0, LoadResString(giQUEUE_SERVICE_COLLISION_RETRY), GetTickCount(), False
  158.             If iRetry < giMAX_ALLOWED_RETRIES Then
  159.                 iRetry = iRetry + 1
  160.                 ir = Int((giRETRY_WAIT_MAX - giRETRY_WAIT_MIN + 1) * Rnd + giRETRY_WAIT_MIN)
  161.                 For il = 0 To ir
  162.                     DoEvents
  163.                 Next il
  164.                 If gbStopping Then Resume Next Else Resume
  165.             Else
  166.                 'We reached our max retries
  167.                 s = LoadResString(giCOLLISION_ERROR)
  168.                 If bLog Then AddLogRecord 0, s, GetTickCount(), False
  169.                 DisplayStatus s
  170.                 StopOnError s
  171.                 Exit Sub
  172.             End If
  173.         Case ERR_OBJECT_VARIABLE_NOT_SET
  174.             'Worker was not successfully created
  175.             s = LoadResString(giQUEUE_SERVICE_ERROR) & CStr(Err.Number) & gsSEPERATOR & Err.Source & gsSEPERATOR & Err.Description
  176.             DisplayStatus Err.Description
  177.             If gbLog Then AddLogRecord 0, s, GetTickCount(), False
  178.             StopOnError s
  179.             Exit Sub
  180.         Case ERR_CANT_FIND_KEY_IN_REGISTRY
  181.             'AEInstancer.Instancer is a work around for error
  182.             '-2147221166 which occurrs every time a client
  183.             'object creates an instance of a remote server,
  184.             'destroys it, registers it local, and tries to
  185.             'create a local instance.  The client can not
  186.             'create an object registered locally after it created
  187.             'an instance while it was registered remotely
  188.             'until it shuts down and restarts.  Therefore,
  189.             'it works to call another process to create the
  190.             'local instance and pass it back.
  191.             Dim oInstancer As AEInstancer.Instancer
  192.             Set oInstancer = New AEInstancer.Instancer
  193.             Set oWorker = oInstancer.object("AEWorker.Worker")
  194.             Set oInstancer = Nothing
  195.             Resume Next
  196.         Case RPC_S_UNKNOWN_AUTHN_TYPE
  197.             Dim iResult As Integer
  198.             'Tried to connect to a server that does not support
  199.             'specified authentication level.  Display message and
  200.             'switch to no authentication and try again
  201.             s = LoadResString(giUSING_NO_AUTHENTICATION)
  202.             DisplayStatus s
  203.             AddLogRecord 0, s, 0, False
  204.             glConnectionAuthentication = RPC_C_AUTHN_LEVEL_NONE
  205.             iResult = goRegClass.SetAutoServerSettings(True, "AEWorker.Worker", , gsConnectionAddress, gsConnectionProtocol, glConnectionAuthentication)
  206.             Resume
  207.         Case ERR_OVER_FLOW
  208.             s = CStr(Err.Number) & gsSEPERATOR & Err.Source & gsSEPERATOR & Err.Description
  209.             lCallNumber = 0
  210.             If gbLog Then AddLogRecord 0, s, GetTickCount(), False
  211.         Case Else
  212.             s = LoadResString(giQUEUE_SERVICE_ERROR) & CStr(Err.Number) & gsSEPERATOR & Err.Source & gsSEPERATOR & Err.Description
  213.             DisplayStatus Err.Description
  214.             If gbLog Then AddLogRecord 0, s, GetTickCount(), False
  215.             If bPostingServices Then
  216.                 StopOnError s
  217.                 Exit Sub
  218.             Else
  219.                 Resume Next
  220.             End If
  221.     End Select
  222. End Sub
  223.